home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / mouse.exe / MOUSE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-06-02  |  40.8 KB  |  1,015 lines
  1. {$O-,R-,I-,V-,F+}
  2. Unit Mouse;
  3. {$UNDEF  GMouse}
  4. {$DEFINE GMouse} {<-- if you are not using graphics remove this definition}
  5.  
  6. {***************************************************************************}
  7. {*              Mouse - Turbo Pascal Mouse Unit Version 3.1                *}
  8. {*                      by Michael Day  05/28/89                           *}
  9. {*                                                                         *}
  10. {*    Based on the Mouse4 unit developed by Richard Sadowsky 11/20/87      *}
  11. {*           Graphics cursor procedure borrowed from EgaMouse              *}
  12. {*                    by Eduardo Martins 02/02/88                          *}
  13. {*                                                                         *}
  14. {*           This program is released to the public domain                 *}
  15. {*                                                                         *}
  16. {*        This program assumes that you have a MS (or compatible)          *}
  17. {*                 mouse driver installed on the computer.                 *}
  18. {*                                                                         *}
  19. {***************************************************************************}
  20.  
  21. { History }
  22.  
  23. { V2.0 First release under this package unkown date -med}
  24. { V2.1 as of 09/10/88 First full release of this package -med}
  25. { V2.2 as of 09/15/88 Corrected Graphic cursor bug in V2.1 which had }
  26. { incorrect tables for some cursors. Also improved the table structure }
  27. { at the same time. -med }
  28. { V2.3 as of 09/28/88 Corrected bug in release V2.2 to fix mouse detect }
  29. { crash when running under DOS 2.x. -med }
  30. { V2.4 as of 04/08/89 fixed checkmark cursor and circle target cursor -med}
  31. { V3.0 as of 05/23/89 added BGI mouse emulation for EGA debugging -med}
  32. { V3.1 as of 05/29/89 added Hercules page control fix BGI mouse cursor}
  33. { to deal with BGI screen edge problem (redraws mouse at edge). -med}
  34.  
  35. {***************************************************************************}
  36.  
  37.  
  38. Interface
  39.  
  40. {$IFDEF GMouse}
  41.   Uses DOS,Graph{,crt};
  42. {$ELSE}
  43.   Uses DOS;
  44. {$ENDIF}
  45.  
  46. {---------------------------------------------------------------------------}
  47. {Externally accessable constants}
  48.  
  49. const
  50.  
  51.   MouseLeftButton   = 1;                               {what the buttons are}
  52.   MouseRightButton  = 2;
  53.   MouseCenterButton = 4;
  54.  
  55.   MouseStandard     = 1;                         {graphic cursor definitions}
  56.   MouseUpArrow      = 2;
  57.   MouseDownArrow    = 3;
  58.   MouseLeftArrow    = 4;
  59.   MouseRightArrow   = 5;
  60.   MouseCheckMark    = 6;
  61.   MouseUpHand       = 7;
  62.   MouseDownHand     = 8;
  63.   MouseLeftHand     = 9;
  64.   MouseRightHand    = 10;
  65.   MouseStopHand     = 11;
  66.   MouseHourGlass    = 12;
  67.   MouseDiagCross    = 13;
  68.   MouseRectCross    = 14;
  69.   MouseRectBox      = 15;
  70.   MouseTargetCross  = 16;
  71.   MouseTargetCircle = 17;
  72.   MouseTargetBox    = 18;
  73.   MouseQuestionMark = 19;
  74.  
  75.   MaxMouseGraphShape = 19;
  76.   MaxMouseTextShape  = 15;
  77.  
  78. {---------------------------------------------------------------------------}
  79. {Externally accessable variables}
  80.  
  81. var  CrtMode : Byte absolute $40:$49;               {BIOS Crt mode flag byte}
  82.      CrtCols : Word absolute $40:$4A;                 {BIOS Crt column count}
  83.      CrtRows : Byte absolute $40:$84;                    {BIOS Crt row count}
  84.      SysClk  : Word absolute $40:$6C;             {BIOS system clock counter}
  85.      CursorMode : Word absolute $40:$60;           {BIOS cursor mode storage}
  86.  
  87. var
  88.   MouseInstalled   : Boolean;   {InitMouse - True if mouse is operable}
  89.   MouseError       : Integer;   {InitMouse - Error code}
  90.   MouseType        : Integer;   {InitMouse - Mouse Type}
  91.  
  92.   MouseClicked     : Boolean;   {ReadMouse - True if button was clicked}
  93.   MouseButtons     : Word;      {ReadMouse - Current mouse button status}
  94.   MouseClickButton : Word;      {ReadMouse - Click button status}
  95.   MouseX           : Integer;   {ReadMouse - Mouse X Position}
  96.   MouseY           : Integer;   {ReadMouse - Mouse Y Position}
  97.   ClickMouseX      : Integer;   {ReadMouse - Mouse X Click Position}
  98.   ClickMouseY      : Integer;   {ReadMouse - Mouse Y Click Position}
  99.   MousePressX      : Integer;   {last mouse button press position}
  100.   MousePressY      : Integer;
  101.   MouseReleaseX    : Integer;   {last mouse button release position}
  102.   MouseReleaseY    : Integer;
  103.  
  104.   MouseHideX1      : Integer;
  105.   MouseHideY1      : Integer;   {HideMouseArea - Mouse hide area}
  106.   MouseHideX2      : Integer;
  107.   MouseHideY2      : Integer;
  108.   MouseAreaX1      : Integer;   {SetMouseArea - Mouse bounded area}
  109.   MouseAreaY1      : Integer;
  110.   MouseAreaX2      : Integer;
  111.   MouseAreaY2      : Integer;
  112.  
  113. const
  114.   MouseGShape        : Integer = 1;            {selected graphic mouse shape}
  115.   MouseTShape        : Integer = 0;               {selected text mouse shape}
  116.   MouseState         : Integer = -1;                {Negative = mouse hidden}
  117.   MouseVisible       : Boolean = false;             {true = mouse is visible}
  118.   MouseCondo         : Boolean = false;     {true = conditional mouse hiding}
  119.   MouseReDraw        : Boolean = false;    {true = mouse needs to be redrawn}
  120.   MouseHooked        : Boolean = false;    {true = mouse hooked to clock int}
  121.   TextMouse          : Boolean = false;         {true = text mode type mouse}
  122.   ZeroMouse          : Boolean = false;       {true = text mouse starts at 0}
  123.   HercGraphMouse     : Boolean = false;        {true = Herc graph mode mouse}
  124.  
  125.   MouseTextWidth     : Word = 8;           {size of text on screen for mouse}
  126.   MouseTextHeight    : Word = 8;
  127.   MaxCrtX            : Word = 80;                 {screen size in characters}
  128.   MaxCrtY            : Word = 25;
  129.  
  130.   MouseColor         : Word = $FFFF;                     {mouse cursor color}
  131.   UseMouseSim        : Boolean = false;   {true = use simulated mouse cursor}
  132.   MouseImageX        : Integer = 0;         {current mouse XY image position}
  133.   MouseImageY        : Integer = 0;
  134.  
  135. {---------------------------------------------------------------------------}
  136. type      MaskType = record                 {mouse graphic cursor definition}
  137.                   Def: array [0..1, 0..15] of word;     {graphics cursor def}
  138.                   HotX, HotY: integer;                       { hot spot X,Y }
  139.                 end;
  140.  
  141. { define what the mouse text cursor definition array looks like }
  142. type MouseTextType = record
  143.                   Select : Word;
  144.                   Start  : Word;
  145.                   Stop   : Word;
  146.                 end;
  147.  
  148. {---------------------------------------------------------------------------}
  149. {Note: You must set the MouseTextWidth and MouseTextHeight values}
  150. {to the current character pixel width and height to properly use the}
  151. {mouse text X,Y coordinate system. Startup Default is 8x8.}
  152. {To start up the mouse you should do the following: }
  153. {InitMouse; ReadMouse; ShowMouse; - This insures that the mouse is}
  154. {properly setup and ready to run. Additionally, if you have a Hercules}
  155. {display, you must call SetHercPage prior to calling InitMouse to properly}
  156. {initialize the mouse driver for the Hercules display.}
  157.  
  158. {For more information on the mouse interface and programming with }
  159. {with a mouse refer to the MicroSoft Mouse Programmer's Reference Guide}
  160. {Available from MicroSoft Corporation.}
  161.  
  162. {Warning: All mouse drivers are not created equal. Nor are programs that }
  163. {use them. Be especially careful with the MouseAreaHide function, if you }
  164. {are using an EGA display with Turbo Pascal it will not work. The area }
  165. {hide function requires that certain EGA display calls be performed through }
  166. {an extended video BIOS call so that it can know what to expect in how the }
  167. {display is setup. Since Turbo Pascal does not do this, The MouseAreaHide }
  168. {function will not currently work under Turbo Pascal. With other displays }
  169. {you shouldn't have a problem. Also be aware that some mouse drivers do not }
  170. {impliment all functions exactly the same, and that the early MS mouse driver}
  171. {did not impliment all the functions listed here. If you have any questions}
  172. {check with your mouse manufacture. The MS mouse Tech ref guide is an }
  173. {invaluable reference if you intend to do mouse programming. You can get it}
  174. {for $25 if you bought an MS mouse. For other mice, check with the}
  175. {manufacture most of them provide Tech ref manuals.}
  176.  
  177.  
  178. {---------------------------------------------------------------------------}
  179. { Function 0 - Initialize mouse software and hardware }
  180. procedure InitMouse;
  181.  
  182.  
  183. {---------------------------------------------------------------------------}
  184. { Function 1 - show mouse cursor }
  185. procedure ShowMouse;
  186.  
  187.  
  188. {---------------------------------------------------------------------------}
  189. { Function 2 - hide mouse cursor }
  190. procedure HideMouse;
  191.  
  192.  
  193. {---------------------------------------------------------------------------}
  194. { Function 3 - read mouse position and button status }
  195. { Use GetMx, GetMy to read the mouse position info in MouseX, MouseY, }
  196. { or ClickMouseX, ClickMouseY }
  197. procedure ReadMouse;
  198.  
  199.  
  200. {---------------------------------------------------------------------------}
  201. { function 4 - sets mouse position }
  202. { Recommended calling method: }
  203. { SetMousePosition(PutMx(X),PutMy(Y)); }
  204. procedure SetMousePosition(X,Y:Integer);
  205.  
  206.  
  207. {---------------------------------------------------------------------------}
  208. { function 5 - gets button press information  }
  209. { Recommended calling method: }
  210. { Status := MousePress(Button,Count); }
  211. { Click position is available in vars ClickMouseX and ClickMouseY}
  212. function MousePress(Button:Word; var Count:Word):Word;
  213.  
  214.  
  215. {---------------------------------------------------------------------------}
  216. { function 6 - gets button release information  }
  217. { Recommended calling method: }
  218. { Status := MouseRelease(Button,Count); }
  219. { Click position is available in vars ClickMouseX and ClickMouseY}
  220. function MouseRelease(Button: Word; var Count:Word):Word;
  221.  
  222.  
  223. {---------------------------------------------------------------------------}
  224. { functions 7 and 8 - sets area where the mouse is allowed to run }
  225. { Recommended calling method: }
  226. { SetMouseArea(PutMx(x1),PutMy(y1),PutMx(x2),PutMy(y2)); }
  227. procedure SetMouseArea(x1,y1,x2,y2:Integer);
  228.  
  229.  
  230. {---------------------------------------------------------------------------}
  231. { function 9 - sets the graphics cursor shape }
  232. procedure MouseGraphicCursor(Shape:Integer);
  233.  
  234.  
  235. {---------------------------------------------------------------------------}
  236. { function 9 - sets a custom graphics cursor shape }
  237. procedure SetMouseGraphicCursor(var Mask:MaskType);
  238.  
  239.  
  240. {---------------------------------------------------------------------------}
  241. { function 10 - sets the text cursor shape }
  242. procedure MouseTextCursor(Shape:Integer);
  243.  
  244.  
  245. {---------------------------------------------------------------------------}
  246. { function 10 - sets a custom text cursor shape }
  247. procedure SetMouseTextCursor(Select,Start,Stop:Word);
  248.  
  249.  
  250. {---------------------------------------------------------------------------}
  251. { function 11 - Read Mouse Motion counters }
  252. procedure ReadMickey(var X,Y:Integer);
  253.  
  254.  
  255. {---------------------------------------------------------------------------}
  256. { function 12 - Set Mouse Interrupt service routine and mask }
  257. procedure SetMouseISR(Mask:Word; Address:Pointer);
  258.  
  259.  
  260. {---------------------------------------------------------------------------}
  261. { function 13 and 14 - Light pen emulation on/off }
  262. procedure LightPen(Flag:Boolean);
  263.  
  264.  
  265. {---------------------------------------------------------------------------}
  266. { function 15 - sets the mickey to pixel ratio }
  267. procedure SetPixeltoMickey(X,Y:Integer);
  268.  
  269.  
  270. {---------------------------------------------------------------------------}
  271. { function 16 - Conditional Mouse Hide - hides mouse if in area }
  272. { use ShowMouse after using this function - just like regular HideMouse }
  273. {Recommended calling method: }
  274. {If HideMouseArea(PutMx(x1),PutMy(y1),PutMx(x2),PutMy(y2)) then DoSomething;}
  275. procedure HideMouseArea(x1,y1,x2,y2:Integer);
  276.  
  277.  
  278. {---------------------------------------------------------------------------}
  279. { function 19 - Set Double Speed Threshold }
  280. procedure MouseThreshold(Threshold:Integer);
  281.  
  282.  
  283. {---------------------------------------------------------------------------}
  284. { function 20 - Swap current Mouse ISR with a new one}
  285. { Returns old ISR and mask in the calling variables }
  286. procedure SwapMouseISR(var Mask:Word; var Address:Pointer);
  287.  
  288.  
  289. {---------------------------------------------------------------------------}
  290. { function 29 - Set Mouse Page }
  291. procedure SetMousePage(Page:Word);
  292.  
  293.  
  294. {---------------------------------------------------------------------------}
  295. { function 30 - Get Mouse Page }
  296. function GetMousePage:Word;
  297.  
  298.  
  299. {---------------------------------------------------------------------------}
  300. { Set Hercules Graphics page for Mouse (not a standard mouse function) }
  301. { 0= graph pg 0,   1= graph pg 1,   -1 = text mode  (see note in procedure) }
  302. procedure SetHercMouse(Pg:Integer);
  303.  
  304.  
  305. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  306. { The following procedures use the mouse functions to provide }
  307. { a higher level of control over the mouse }
  308.  
  309. {---------------------------------------------------------------------------}
  310. { Normalizes a mouse X position to standard position info }
  311. function GetMx(X:Integer):Integer;
  312.  
  313.  
  314. {---------------------------------------------------------------------------}
  315. { Normalizes a mouse Y position to standard position info }
  316. function GetMy(Y:Integer):Integer;
  317.  
  318.  
  319. {---------------------------------------------------------------------------}
  320. { converts a standard X position to a mouse X position }
  321. function PutMx(X:Integer):Integer;
  322.  
  323.  
  324. {---------------------------------------------------------------------------}
  325. { converts a standard Y position to a mouse Y position }
  326. function PutMy(Y:Integer):Integer;
  327.  
  328.  
  329. {---------------------------------------------------------------------------}
  330. { Check if a mouse point is currently in the specified area}
  331. { returns true if it is, false if not}
  332. {  Recommended calling method: }
  333. {  If MousePointIn(GetMx(Mx),GetMy(My), x1,y1,x2,y2) then DoSomething;}
  334. function MousePointIn(Mx,My, x1,y1,x2,y2:Integer):Boolean;
  335.  
  336.  
  337. {---------------------------------------------------------------------------}
  338. {has the mouse been clicked recently?}
  339. function MouseClick:Boolean;
  340.  
  341.  
  342. {---------------------------------------------------------------------------}
  343. {Hooks the Mouse function to the system clock}
  344. {State = true hooks the mouse up, State = false disconnects the mouse}
  345. procedure MouseClock(State:Boolean);
  346.  
  347.  
  348. {---------------------------------------------------------------------------}
  349. {Pushes current mouse status on the mouse stack}
  350. {Returns false if not enough heap space to push}
  351. function PushMouse:Boolean;
  352.  
  353.  
  354. {---------------------------------------------------------------------------}
  355. {Pops mouse status from the mouse stack.}
  356. function PopMouse:Boolean;
  357.  
  358.  
  359. {---------------------------------------------------------------------------}
  360. {Get rid of mouse stack}
  361. procedure ZapMouseStack;
  362.  
  363.  
  364. {***************************************************************************}
  365.  
  366. implementation
  367.  
  368. {---------------------------------------------------------------------------}
  369. {private variables}
  370.  
  371. var  MouseBusy   : Boolean;                {true = mouse routines are in use}
  372.      OldMouseX   : Integer;                       {Previous mouse X Position}
  373.      OldMouseY   : Integer;                       {Previous mouse Y Position}
  374.      CustomMask  : MaskType;           {storage for custom mouse cursor data}
  375.      CustomText  : MouseTextType;      {storage for custom text mouse cursor}
  376.      MouseReg    : Registers;        {registers used to call mouse interrupt}
  377.      MouseTemp   : Integer;                     {Temp mouse storage variable}
  378.  
  379. {---------------------------------------------------------------------------}
  380. {$IFDEF GMouse}                 { if we are using graphics enable this stuff}
  381.  
  382. const MouseBack : pointer = nil;          {^old image under BGI mouse cursor}
  383.       MouseMask : pointer = nil;                     {^BGI mouse cursor mask}
  384.       MouseFore : pointer = nil;                  {^BGI mouse cursor overlay}
  385.       MouseSize : word = 0;            {storage size for mouse image 0=emtpy}
  386.       EndImageX : Integer = 0;                         {End of Mouse X image}
  387.       EndImageY : Integer = 0;                         {End of Mouse Y image}
  388.       OldImageX : integer = 0;                {position of image under mouse}
  389.       OldImageY : integer = 0;
  390. {$ENDIF}
  391.  
  392.  
  393. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  394. { mouse include files }
  395.  
  396. {$I MOUSECUR.PAS}    {include the mouse cursor definition table}
  397. {$I MOUSESUB.PAS}    {include special mouse subroutines and code}
  398. {$I MOUSESTK.PAS}    {include the mouse stack routines}
  399. {$I MOUSEISR.PAS}    {include the mouse ISR routines}
  400.  
  401.  
  402. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  403. { the following are the standard mouse driver interface routines }
  404. { these routines use a mouse driver to communicate with the attached }
  405. { mouse. If a mouse is not there, then you can still simulate a mouse, }
  406. { but you will have to do much of the handling yourself. See the }
  407. { MOUSE.DOC documentation file for more information on using the MOUSE unit.}
  408.  
  409.  
  410. {***************************************************************************}
  411. { Function 0 - Initialize mouse software and hardware }
  412. { returns MouseError = 1 if no driver, 0 if driver but no mouse, }
  413. { or -1 if all ok. (I know it's messy, but you can blame MS for that.) }
  414.  
  415. procedure InitMouse;
  416. var Mint : Pointer absolute $0000:$00CC;   {<-- this points to the mouse int}
  417. begin
  418.    MouseBusy := true;       {disallow re-entrant use of routine by mouse ISR}
  419.    MouseState := -1;                              {<-- clear the mouse state}
  420.    MouseGShape := 1;                    {<-- switch to std graph mouse shape}
  421.    MouseTShape := 0;                     {<-- switch to std text mouse shape}
  422.    MouseVisible := false;                 {<-- mouse starts off as invisible}
  423.    MouseReDraw := false;
  424.    MouseCondo := false;
  425.    MouseClicked := false;
  426.    MouseButtons := 0;                                 {<-- reset the buttons}
  427.    MouseClickButton := 0;
  428.    ClickMouseX := 0;                           {<-- clear mouse XY locations}
  429.    ClickMouseY := 0;
  430.    MousePressX := 0;
  431.    MousePressY := 0;
  432.    MouseReleaseX := 0;
  433.    MouseReleaseY := 0;
  434.  
  435.    MouseX := 0;
  436.    MouseY := 0;
  437.    OldMouseX := 0;
  438.    OldMouseY := 0;
  439.    MouseHideX1 := -1;
  440.    MouseHideX2 := -1;                  {Save HideMouseArea - Mouse hide area}
  441.    MouseHideY1 := -1;
  442.    MouseHideY2 := -1;
  443.  
  444.    InitMouseMode;                 {<-- Init the text/graphic mode parameters}
  445.  
  446.    MouseInstalled := false;                              {<-- assume failure}
  447.    MouseType := 0;
  448.    MouseError := 1;                        {<-- 1 means driver not installed}
  449.    if Mint = nil then Exit;                 {<-- if vector is nil, no driver}
  450.    if byte(Mint^) = $CF then Exit;         {<-- if points to IRET, no driver}
  451.  
  452.    MouseReg.AX := 0;              {tell the mouse to start over from scratch}
  453.    MouseReg.BX := 0;
  454.    Intr($33,MouseReg);
  455.    MouseError := MouseReg.AX;
  456.    MouseType := MouseReg.BX;
  457.    MouseInstalled := MouseError = -1;       {<-- check if mouse is out there}
  458.                               { 0 means mouse not available, -1 means all ok}
  459.    if MouseInstalled then
  460.    begin
  461.      MouseReg.AX := 3;
  462.      Intr($33,MouseReg);                     {Get the current mouse location}
  463.      MouseX := MouseReg.CX;                       {save mouse X and Y values}
  464.      MouseY := MouseReg.DX;
  465.    end
  466.    else
  467.    begin
  468.      MouseX := MouseAreaX2 shr 1;             {start with calculated default}
  469.      MouseY := MouseAreaY2 shr 1;                 {screen center if no mouse}
  470.    end;
  471.  
  472. {$IFDEF GMouse}                                   { if we are using graphics}
  473.    if not(MouseInstalled) then                   { and if there is no mouse,}
  474.    begin                                         { then set it to the center}
  475.      MouseX := GetMaxX shr 1;                                { of the screen}
  476.      MouseY := GetMaxY shr 1;
  477.    end;
  478.  
  479.    if MouseBack <> nil then         { if BGI mouse cursor is on, turn it off}
  480.    begin
  481.      PutImage(OldImageX,OldImageY,MouseBack^,NormalPut);
  482.      FreeMem(MouseBack,sizeof(MouseBack^));
  483.    end;
  484.    if MouseMask <> nil then                      { release all cursor memory}
  485.      FreeMem(MouseMask,sizeof(MouseMask^));
  486.    if MouseFore <> nil then
  487.      FreeMem(MouseFore,sizeof(MouseFore^));
  488.    MouseSize := 0;                                {<-- mark that it is empty}
  489. {$ENDIF}
  490.  
  491.   OldMouseX := MouseX;
  492.   OldMouseY := MouseY;
  493.   MouseBusy := false;                  {Polled use of read mouse is done now}
  494. end;
  495.  
  496. {---------------------------------------------------------------------------}
  497. { function 1 - show mouse cursor }
  498.  
  499. procedure ShowMouse;
  500. var OldBusy : Boolean;
  501. begin
  502.   OldBusy := MouseBusy;                               {save old mouse status}
  503.   MouseBusy := true;        {disallow re-entrant use of routine by mouse ISR}
  504.   if MouseState < 0 then
  505.     inc(MouseState);               {<-- adjust current mouse state indicator}
  506.   MouseCondo := false;
  507.  
  508.   {if using mouse driver and it is available do it this way}
  509.   if not(UseMouseSim) and MouseInstalled then
  510.   begin
  511.     MouseReg.AX := 1;                 {if mouse is out there call the driver}
  512.     Intr($33,MouseReg);               {to pick up the current mouse position}
  513.     MouseVisible := true;
  514.     MouseBusy := OldBusy;                {restore previous mouse busy status}
  515.     Exit;
  516.   end;
  517.  
  518.   {if using simulator and mouse driver is available get position from mouse}
  519.   if MouseInstalled then
  520.   begin
  521.     MouseReg.Ax := 3;                          { first find out where we are}
  522.     Intr($33,MouseReg);
  523.     MouseX := MouseReg.CX;               { and update our location registers}
  524.     MouseY := MouseReg.DX;
  525.   end;
  526.  
  527.   ShowMouseSim;                               {display simulated mouse image}
  528.   MouseBusy := OldBusy;                  {restore previous mouse busy status}
  529. end;
  530.  
  531.  
  532. {---------------------------------------------------------------------------}
  533. { function 2 - hide mouse cursor }
  534.  
  535. procedure HideMouse;
  536. var OldBusy : Boolean;
  537. begin
  538.   OldBusy := MouseBusy;                               {save old mouse status}
  539.   MouseBusy := true;        {disallow re-entrant use of routine by mouse ISR}
  540.   dec(MouseState);                 {<-- adjust current mouse state indicator}
  541.   MouseVisible := false;
  542.   MouseCondo := false;
  543.  
  544.   {if using mouse driver and it is available do it this way}
  545.   if not(UseMouseSim) and MouseInstalled then
  546.   begin
  547.     MouseReg.AX := 2;                        {use mouse driver to hide mouse}
  548.     Intr($33,MouseReg);
  549.   end
  550.   else
  551.   begin
  552.     if MouseState = -1 then              { If mouse was visible, hide it now}
  553.       HideMouseSim;                             {use simulator to hide mouse}
  554.   end;
  555.   MouseBusy := OldBusy;                  {restore previous mouse busy status}
  556. end;
  557.  
  558.  
  559. {---------------------------------------------------------------------------}
  560. { function 3 - read current mouse position and button status }
  561. { Use GetMx, GetMy to read the mouse position info in MouseX, MouseY, }
  562. { or ClickMouseX, ClickMouseY }
  563.  
  564. procedure ReadMouse;
  565. begin
  566.   MouseBusy := true;        {disallow re-entrant use of routine by mouse ISR}
  567.   if MouseInstalled then    {if mouse installed, then use it for positioning}
  568.   begin
  569.     MouseReg.AX := 3;
  570.     Intr($33,MouseReg);                        {Get the current mouse status}
  571.     with MouseReg do
  572.     begin
  573.       OldMouseX := MouseX;                          {save old mouse position}
  574.       OldMouseY := MouseY;
  575.       MouseX := CX;                           {save new mouse X and Y values}
  576.       MouseY := DX;
  577.       if (BX <> MouseButtons) and (BX <> 0) then       {<-- new button down?}
  578.       begin
  579.         MouseClickButton := BX;               {if button down save which one}
  580.         ClickMouseX := MouseX;                          {and the current X,Y}
  581.         ClickMouseY := MouseY;
  582.         MouseClicked := true;                      {tell them it was clicked}
  583.       end;
  584.       MouseButtons := BX;                {<-- save the current button status}
  585.     end;
  586.   end;
  587.  
  588.   if UseMouseSim then                 {only do this if using simulated mouse}
  589.   begin
  590.     if ((OldMouseX <> MouseX) or       {if the mouse has moved and is active}
  591.        (OldMouseY <> MouseY)) and                    {then update the cursor}
  592.        (MouseState >= 0) then
  593.     begin
  594.        if not(MouseInstalled) then                 {if mouse isn't installed}
  595.        begin
  596.          OldMouseX := MouseX;                       {save old mouse position}
  597.          OldMouseY := MouseY;              {otherwise we let mouse do update}
  598.        end;
  599.  
  600.        if not(MouseCondo) then     {area hide is not active, so just show it}
  601.        begin
  602.          ShowMouse;
  603.          MouseBusy := false;           {Polled use of read mouse is done now}
  604.          Exit;
  605.        end;
  606.  
  607.        {area hide is active, so see if mouse is in hidden area}
  608.        if (MouseX >= MouseHideX1) or (MouseX <= MouseHideX2) or
  609.           (MouseY >= MouseHideX2) or (MouseY <= MouseHideY2) then
  610.        begin
  611.          if MouseVisible then     {mouse in hidden area & visible so hide it}
  612.            HideMouse;
  613.        end
  614.        else
  615.        begin
  616.          ShowMouse;                          {mouse position is ok, so show it}
  617.        end;
  618.        MouseCondo := true;                       {restore MouseCondo condition}
  619.     end;
  620.  
  621.   end;  {if UseMouseSim then}
  622.   MouseBusy := false;                  {Polled use of read mouse is done now}
  623. end;
  624.  
  625. {---------------------------------------------------------------------------}
  626. { function 4 - sets mouse position }
  627. { Recommended calling method: }
  628. { SetMousePosition(PutMx(X),PutMy(Y)); }
  629.  
  630. procedure SetMousePosition(X,Y:Integer);
  631. begin
  632.   MouseBusy := true;        {disallow re-entrant use of routine by mouse ISR}
  633.   MouseX := IntLimit(X,MouseAreaX1,MouseAreaX2);             {limit mouse to}
  634.   MouseY := IntLimit(Y,MouseAreaY1,MouseAreaY2);               {defined area}
  635.  
  636.   if MouseInstalled then                        {<-- can't do this, no mouse}
  637.   begin
  638.     MouseReg.AX := 4;
  639.     MouseReg.CX := X;                                {tell mouse where to go}
  640.     MouseReg.DX := Y;
  641.     intr($33,MouseReg);
  642.   end;
  643.   MouseBusy := false;                  {Polled use of read mouse is done now}
  644. end;
  645.  
  646. {---------------------------------------------------------------------------}
  647. { function 5 - gets button press information  }
  648. { Recommended calling method: }
  649. { Status := MousePress(Button,Count); }
  650. { Click position is available in vars MousePressX and MousePressY}
  651.  
  652. function MousePress(Button:Word; var Count:Word):Word;
  653. begin
  654.   if not(MouseInstalled) then                      {check if mouse installed}
  655.   begin
  656.     MousePress := 0;              {if no mouse everything comes back as zero}
  657.     Count := 0;
  658.     Exit;
  659.   end;
  660.  
  661.   MouseBusy := true;        {disallow re-entrant use of routine by mouse ISR}
  662.   MouseReg.AX := 5;
  663.   MouseReg.BX := Button;                         {request info on the button}
  664.   intr($33,MouseReg);
  665.   MousePress := MouseReg.AX;
  666.   Count := MouseReg.BX;                      {return the info for the button}
  667.   MousePressX := MouseReg.CX;
  668.   MousePressY := MouseReg.DX;          {position info returned in press vars}
  669.   MouseBusy := false;                  {Polled use of read mouse is done now}
  670. end;
  671.  
  672. {---------------------------------------------------------------------------}
  673. { function 6 - gets button release information  }
  674. { Recommended calling method: }
  675. { Status := MouseRelease(Button,Count); }
  676. { Click position is available in vars MouseReleaseX and MouseReleaseY}
  677.  
  678. function MouseRelease(Button: Word; var Count:Word):Word;
  679. begin
  680.   if not(MouseInstalled) then                      {check if mouse installed}
  681.   begin
  682.     MouseRelease := 0;            {if no mouse everything comes back as zero}
  683.     Count := 0;
  684.     Exit;
  685.   end;
  686.  
  687.   MouseBusy := true;        {disallow re-entrant use of routine by mouse ISR}
  688.   MouseReg.AX := 6;
  689.   MouseReg.BX := Button;                         {request info on the button}
  690.   intr($33,MouseReg);
  691.   MouseRelease := MouseReg.AX;
  692.   Count := MouseReg.BX;                      {return the info for the button}
  693.   MouseReleaseX := MouseReg.CX;
  694.   MouseReleaseY := MouseReg.DX;      {position info returned in release vars}
  695.   MouseBusy := false;                  {Polled use of read mouse is done now}
  696. end;
  697.  
  698. {---------------------------------------------------------------------------}
  699. { functions 7 and 8 - sets area where the mouse is allowed to run }
  700. { Recommended calling method: }
  701. { SetMouseArea(PutMx(x1),PutMy(y1),PutMx(x2),PutMy(y2)); }
  702.  
  703. procedure SetMouseArea(x1,y1,x2,y2:Integer);
  704. begin
  705.   MouseBusy := true;        {disallow re-entrant use of routine by mouse ISR}
  706.   MouseAreaX1 := x1;                                 {save active mouse area}
  707.   MouseAreaY1 := y1;
  708.   MouseAreaX2 := x2;
  709.   MouseAreaY2 := y2;
  710.  
  711.   if MouseInstalled then            {if no mouse we can't send it new values}
  712.   begin
  713.     MouseReg.CX := x1;                                     {set the X values}
  714.     MouseReg.DX := x2;
  715.     MouseReg.AX := 7;
  716.     intr($33,MouseReg);
  717.  
  718.     MouseReg.CX := y1;                                     {set the Y values}
  719.     MouseReg.DX := y2;
  720.     MouseReg.AX := 8;
  721.     intr($33,MouseReg);
  722.   end;
  723.  
  724.   MouseBusy := false;                  {Polled use of read mouse is done now}
  725. end;
  726.  
  727. {---------------------------------------------------------------------------}
  728. { function 9 - sets a custom graphics cursor shape }
  729.  
  730. procedure SetMouseGraphicCursor(var Mask:MaskType);
  731. begin
  732.    MouseBusy := true;        {disallow re-entrant use of routine by mouse ISR}
  733.    move(Mask,CustomMask,sizeof(Mask));             { copy to local variable }
  734.    MouseGShape := -1;                            { -1 = custom mouse cursor }
  735.  
  736.    if MouseInstalled then             {if no mouse we can't send it new data}
  737.    begin
  738.      MouseReg.AX := 9;
  739.      MouseReg.BX := Mask.HotX;                           { set the Hot Spot }
  740.      MouseReg.CX := Mask.HotY;
  741.      MouseReg.ES := seg(Mask.Def);
  742.      MouseReg.DX := ofs(Mask.Def);               { set the new cursor shape }
  743.      Intr($33, MouseReg);
  744.    end;
  745.  
  746.    MouseBusy := false;                 {Polled use of read mouse is done now}
  747. end;
  748.  
  749. {---------------------------------------------------------------------------}
  750. { function 9 - sets the graphics cursor shape }
  751. { Graphic cursor routine borrowed from EGAMouse }
  752. { (and then re-written) }
  753.  
  754. procedure MouseGraphicCursor(Shape:Integer);
  755. begin
  756.    MouseGShape := IntLimit(Shape,1,MaxMouseGraphShape);   {save shape number}
  757.    if not(MouseInstalled) then Exit;            {<-- can't do this, no mouse}
  758.  
  759.    with MouseGCursor[MouseGShape] do
  760.    begin
  761.      MouseBusy := true;     {disallow re-entrant use of routine by mouse ISR}
  762.      MouseReg.AX := 9;
  763.      MouseReg.BX := HotX;                                { set the Hot Spot }
  764.      MouseReg.CX := HotY;
  765.      MouseReg.ES := seg(Def);
  766.      MouseReg.DX := ofs(Def);                    { set the new cursor shape }
  767.      Intr($33, MouseReg);
  768.      MouseBusy := false;               {Polled use of read mouse is done now}
  769.    end;
  770. end;
  771.  
  772. {---------------------------------------------------------------------------}
  773. { function 10 - sets a custom text cursor shape }
  774.  
  775. procedure SetMouseTextCursor(Select,Start,Stop:Word);
  776. begin
  777.    MouseTShape := -1;                            { -1 = custom mouse cursor }
  778.    if not(MouseInstalled) then Exit;            {<-- can't do this, no mouse}
  779.  
  780.    MouseBusy := true;       {disallow re-entrant use of routine by mouse ISR}
  781.    MouseReg.AX := 10;
  782.    MouseReg.BX := Select;                            { set the select value }
  783.    MouseReg.CX := Start;                          { set the new start value }
  784.    MouseReg.DX := Stop;                            { set the new stop value }
  785.    Intr($33, MouseReg);
  786.    MouseBusy := false;                 {Polled use of read mouse is done now}
  787. end;
  788.  
  789. {---------------------------------------------------------------------------}
  790. { function 10 - sets the text cursor shape }
  791.  
  792. procedure MouseTextCursor(Shape:Integer);
  793. begin
  794.    MouseTShape := IntLimit(Shape,0,MaxMouseTextShape);    {save shape number}
  795.    if not(MouseInstalled) then Exit;            {<-- can't do this, no mouse}
  796.  
  797.    MouseBusy := true;       {disallow re-entrant use of routine by mouse ISR}
  798.    if Shape > 0 then          {greater than zero means get values from array}
  799.    begin
  800.      with MouseTCursor[MouseTShape] do
  801.       begin
  802.         MouseReg.BX := Select;                       { set the select value }
  803.         MouseReg.CX := Start;                     { set the new start value }
  804.         MouseReg.DX := Stop;                       { set the new stop value }
  805.      end;
  806.    end
  807.    else              { zero means to use current hardware cursor definition }
  808.    begin
  809.      MouseReg.BX := 1;                               { set the select value }
  810.      MouseReg.CX := hi(CursorMode);               { set the new start value }
  811.      MouseReg.DX := lo(CursorMode);                { set the new stop value }
  812.    end;
  813.    MouseReg.AX := 10;
  814.    Intr($33, MouseReg);
  815.    MouseBusy := false;                 {Polled use of read mouse is done now}
  816. end;
  817.  
  818. {---------------------------------------------------------------------------}
  819. { function 11 - Read Mouse Motion counters }
  820.  
  821. procedure ReadMickey(var X,Y:Integer);
  822. begin
  823.   if not(MouseInstalled) then                      {check if mouse installed}
  824.   begin
  825.     X := 0;                                  {if no mouse return zero values}
  826.     Y := 0;
  827.     Exit;
  828.   end;
  829.  
  830.   MouseBusy := true;        {disallow re-entrant use of routine by mouse ISR}
  831.   MouseReg.AX := 11;
  832.   Intr($33, MouseReg);
  833.   X := MouseReg.CX;                                    {return mickey values}
  834.   Y := MouseReg.DX;
  835.   MouseBusy := false;                  {Polled use of read mouse is done now}
  836. end;
  837.  
  838. {---------------------------------------------------------------------------}
  839. { function 12 - Set Mouse Interrupt service routine and mask }
  840.  
  841. procedure SetMouseISR(Mask:Word; Address:Pointer);
  842. type Arec = record Lo, Hi: Word; end;
  843. var A : Arec absolute Address;
  844. begin
  845.   if not(MouseInstalled) then Exit;             {<-- can't do this, no mouse}
  846.  
  847.   MouseBusy := true;        {disallow re-entrant use of routine by mouse ISR}
  848.   MouseReg.CX := Mask;                         {<-- set the ISR service mask}
  849.   MouseReg.ES := A.Hi;
  850.   MouseReg.DX := A.Lo;                          {set the ISR service address}
  851.   MouseReg.AX := 12;
  852.   Intr($33, MouseReg);
  853.   MouseBusy := false;                  {Polled use of read mouse is done now}
  854. end;
  855.  
  856. {---------------------------------------------------------------------------}
  857. { function 13 and 14 - Light pen emulation on/off }
  858.  
  859. procedure LightPen(Flag:Boolean);
  860. begin
  861.   if not(MouseInstalled) then Exit;             {<-- can't do this, no mouse}
  862.  
  863.   MouseBusy := true;        {disallow re-entrant use of routine by mouse ISR}
  864.   if Flag then
  865.     MouseReg.AX := 13                            {set light pen emulation on}
  866.   else
  867.     MouseReg.AX := 14;                          {set light pen emulation off}
  868.   Intr($33,MouseReg);
  869.   MouseBusy := false;                  {Polled use of read mouse is done now}
  870. end;
  871.  
  872.  
  873. {---------------------------------------------------------------------------}
  874. { function 15 - sets the mickey to pixel ratio }
  875.  
  876. procedure SetPixeltoMickey(X,Y:Integer);
  877. begin
  878.   if not(MouseInstalled) then Exit;             {<-- can't do this, no mouse}
  879.  
  880.   MouseBusy := true;        {disallow re-entrant use of routine by mouse ISR}
  881.   MouseReg.AX := 15;
  882.   MouseReg.CX := X;                               {set the new mickey values}
  883.   MouseReg.DX := Y;
  884.   Intr($33,MouseReg);
  885.   MouseBusy := false;                  {Polled use of read mouse is done now}
  886. end;
  887.  
  888.  
  889. {---------------------------------------------------------------------------}
  890. { function 16 - Conditional Mouse Hide - hides mouse if in text area }
  891. { use ShowMouse after using this function - just like regular HideMouse }
  892. {Recommended calling method: }
  893. {If HideMouseArea(PutMx(x1),PutMy(y1),PutMx(x2),PutMy(y2)) then DoSomething;}
  894.  
  895. procedure HideMouseArea(x1,y1,x2,y2:Integer);
  896. begin
  897.   MouseBusy := true;        {disallow re-entrant use of routine by mouse ISR}
  898.   MouseCondo := true;                   {<-- flag conditional hideing active}
  899.   MouseHideX1 := x1;
  900.   MouseHideX2 := x2;                   {Save HideMouseArea - Mouse hide area}
  901.   MouseHideY1 := y1;
  902.   MouseHideY2 := y2;
  903.  
  904.   if MouseInstalled then                 {if mouse is out there, then set it}
  905.   begin
  906.     MouseReg.CX := x1;                               {set the X and Y values}
  907.     MouseReg.DX := x2;
  908.     MouseReg.SI := y1;
  909.     MouseReg.DI := y2;
  910.     MouseReg.AX := 16;
  911.     intr($33,MouseReg);
  912.   end;
  913.  
  914.   if (MouseX >= MouseHideX1) or (MouseX <= MouseHideX2) or
  915.      (MouseY >= MouseHideX2) or (MouseY <= MouseHideY2) then
  916.   begin
  917.     if MouseVisible then            {if mouse is in hidden area then hide it}
  918.       HideMouse;
  919.   end
  920.   else
  921.     ShowMouse;                {if mouse not in area, then keep mouse visible}
  922.   MouseCondo := true;         {indicate that we are in conditional hide mode}
  923.   MouseBusy := false;                  {Polled use of read mouse is done now}
  924. end;
  925.  
  926. {---------------------------------------------------------------------------}
  927. { function 19 - Set Double Speed Threshold }
  928.  
  929. procedure MouseThreshold(Threshold:Integer);
  930. begin
  931.   if not(MouseInstalled) then Exit;             {<-- can't do this, no mouse}
  932.  
  933.   MouseBusy := true;        {disallow re-entrant use of routine by mouse ISR}
  934.   MouseReg.AX := 19;
  935.   MouseReg.DX := Threshold;                     {set the new threshold value}
  936.   Intr($33,MouseReg);
  937.   MouseBusy := false;                  {Polled use of read mouse is done now}
  938. end;
  939.  
  940.  
  941. {---------------------------------------------------------------------------}
  942. { function 20 - Swap current Mouse ISR with a new one}
  943. { Returns old ISR and mask in the calling variables }
  944.  
  945. procedure SwapMouseISR(var Mask:Word; var Address:Pointer);
  946. type Arec = record Lo, Hi: Word; end;
  947. var A : Arec absolute Address;
  948. begin
  949.   if not(MouseInstalled) then Exit;             {<-- can't do this, no mouse}
  950.  
  951.   MouseBusy := true;        {disallow re-entrant use of routine by mouse ISR}
  952.   MouseReg.CX := Mask;                         {<-- set new ISR service mask}
  953.   MouseReg.ES := A.Hi;
  954.   MouseReg.DX := A.Lo;                          {set new ISR service address}
  955.   MouseReg.AX := 20;
  956.   Intr($33,MouseReg);
  957.   Mask := MouseReg.CX;                         {<-- Get old ISR service mask}
  958.   A.Hi := MouseReg.ES;
  959.   A.Lo := MouseReg.DX;                          {Get old ISR service address}
  960.   MouseBusy := false;                  {Polled use of read mouse is done now}
  961. end;
  962.  
  963. {---------------------------------------------------------------------------}
  964. { function 29 - Set Mouse Page }
  965.  
  966. procedure SetMousePage(Page:Word);
  967. begin
  968.   if not(MouseInstalled) then Exit;             {<-- can't do this, no mouse}
  969.  
  970.   MouseBusy := true;        {disallow re-entrant use of routine by mouse ISR}
  971.   MouseReg.AX := 29;
  972.   MouseReg.BX := Page;                          {set the new threshold value}
  973.   Intr($33,MouseReg);
  974.   MouseBusy := false;                  {Polled use of read mouse is done now}
  975. end;
  976.  
  977. {---------------------------------------------------------------------------}
  978. { function 30 - Get Mouse Page }
  979.  
  980. function GetMousePage:Word;
  981. begin
  982.   if not(MouseInstalled) then Exit;             {<-- can't do this, no mouse}
  983.  
  984.   MouseBusy := true;        {disallow re-entrant use of routine by mouse ISR}
  985.   MouseReg.AX := 29;
  986.   Intr($33,MouseReg);
  987.   GetMousePage := MouseReg.BX;                  {get the new threshold value}
  988.   MouseBusy := false;                  {Polled use of read mouse is done now}
  989. end;
  990.  
  991.  
  992. {***************************************************************************}
  993. {Initialization section}
  994.  
  995. begin
  996. {$IFDEF GMouse}                 { if we are using graphics enable this stuff}
  997.   MouseBack := nil;                              {start with no mouse cursor}
  998.   MouseMask := nil;
  999.   MouseFore := nil;
  1000.   MouseSize := 0;
  1001. {$ENDIF}
  1002.  
  1003.   MouseHooked := false;            {mouse starts out disconnected from clock}
  1004.   MouseBusy := false;                         {start off with mouse not busy}
  1005.   Old1CVect := Int1CVect;           {save current vector for clock interrupt}
  1006.   ExitSave := ExitProc;                          {hook up the Exit procedure}
  1007.   ExitProc := @MouseExit;
  1008.   MouseStack := nil;                                 {no mouse stack present}
  1009.   InitMouse;                                           {initialize the mouse}
  1010. end.
  1011.  
  1012. {***************************************************************************}
  1013. { EOF }
  1014.  
  1015.